El objetivo de este analisis es investigar las principiales diferencias entre 3 especies de pinguinos y estudiar como se distribuyen las poblaciones en 3 islas del artico. Se dará un principal enfoque a el análisis por grupo de especie y se espera descubrir detalles interesantes.
##
## To cite palmerpenguins in publications use:
##
## Horst AM, Hill AP, Gorman KB (2020). palmerpenguins: Palmer
## Archipelago (Antarctica) penguin data. R package version 0.1.0.
## https://allisonhorst.github.io/palmerpenguins/
##
## A BibTeX entry for LaTeX users is
##
## @Manual{,
## title = {palmerpenguins: Palmer Archipelago (Antarctica) penguin data},
## author = {Allison Marie Horst and Alison Presmanes Hill and Kristen B Gorman},
## year = {2020},
## note = {R package version 0.1.0},
## url = {https://allisonhorst.github.io/palmerpenguins/},
## }
penguins_df <- as.data.frame(penguins)
penguins_df <- na.omit(penguins_df)
names(penguins_df) = c("Especie", "Isla", "Longitud Pico", "Profundidad Pico", "Longitud aleta", "Masa Corporal", "Sexo","Año")variables <- c("Especie", "Isla", "Longitud Pico", "Profundidad Pico", "Longitud aleta", "Masa Corporal", "Sexo","Año")
tipo <- c("Cualitativa - Nominal","Cualitativa - Nominal","Cuantitativa - De razón","Cuantitativa - De razón","Cuantitativa - De razón","Cuantitativa - De razón","Cualitativa - Nominal","Cualitativa - Nominal")
mat <- cbind(variables,tipo)
rownames(mat)<- 1:8
colnames(mat)<- c("Variable","Tipo de Variable")
mat## Variable Tipo de Variable
## 1 "Especie" "Cualitativa - Nominal"
## 2 "Isla" "Cualitativa - Nominal"
## 3 "Longitud Pico" "Cuantitativa - De razón"
## 4 "Profundidad Pico" "Cuantitativa - De razón"
## 5 "Longitud aleta" "Cuantitativa - De razón"
## 6 "Masa Corporal" "Cuantitativa - De razón"
## 7 "Sexo" "Cualitativa - Nominal"
## 8 "Año" "Cualitativa - Nominal"
#Frecuencias absolutas
fatable <- sort(table(penguins_df$Especie))
a <- sum(fatable)
fi<-c(fatable,a)
#Frecuencias relativas
frtable <- round(prop.table(fatable),digits = 3)
b <- sum(frtable)
pi <- c(frtable,b)
#Frecuencias absolutas acumuladas
faa <- sort(cumsum(fatable))
c <- sum(faa)
faai <- c(faa,c)
#Frecuencias relativas acumuladas
fra <- round(cumsum(frtable),digits=3)
d<- sum(fra)
frai <- c(fra,d)
#Tabla final
tfinal <- cbind(fi,faai, pi,frai)
rownames(tfinal) <- c(names(fatable),"Totales")
colnames(tfinal) <- c("FA" ,
"FAA" ,
"FR",
"FRA")
tfinal## FA FAA FR FRA
## Chinstrap 68 68 0.204 0.204
## Gentoo 119 187 0.357 0.561
## Adelie 146 333 0.438 0.999
## Totales 333 588 0.999 1.764
penguins_df %>%
count(Especie,Sexo)%>%
plot_ly(x= ~Especie,
y= ~n,
text= ~n,
hoverinfo = "text",
color=~Sexo,
colors=c("yellowgreen","seagreen1"))%>%
add_bars()%>%
layout(title="Especies por Sexo",
xaxis= list(title="Especie"),
yaxis= list(title="Número"),
barmode="group")penguins_df %>%
count(Especie,Isla)%>%
plot_ly(x= ~Especie,
y= ~n,
text= ~n,
hoverinfo = "text",
color=~Isla)%>%
add_bars()%>%
layout(title="Especies por Isla",
xaxis= list(title="Especie"),
yaxis= list(title="Número"),
barmode="group")penguins_df %>%
count(Sexo,Isla)%>%
plot_ly(x= ~Sexo,
y= ~n,
text= ~n,
hoverinfo = "text",
color=~Isla)%>%
add_bars()%>%
layout(title="Sexo por Isla",
xaxis= list(title="Sexo"),
yaxis= list(title="Número"),
barmode="group")Comentarios:
La muestra se compone de 333 pingüinos donde 43.8% es del tipo Adelie, 35.7% Gentoo y 20.4% Chinstrap.
El número de machos y hembras en cada especie es curiosamente el mismo.
La distribución de cada especie en las islas es curiosa, ya que la especie Adelie se encuentra presente en las 3 islas con un número similar de individuos, mientras que la especie Chinstrap y Gentoo se encuentran unicamente en la isla Dream y Biscoe respectivamente.
Existe equilibrio entre el número de hembras y machos en las 3 islas.
- Longitud de Pico
groupA <- penguins_df %>% filter(Especie == "Adelie")
groupB <- penguins_df %>% filter(Especie == "Gentoo")
groupC <- penguins_df %>% filter(Especie == "Chinstrap")
p5 <- plot_ly(alpha = 0.7) %>%
add_histogram(x = ~groupA$`Longitud Pico`,
name = "Adelie") %>%
add_histogram(x = ~groupB$`Longitud Pico`,
name = "Gentoo") %>%
add_histogram(x = ~groupC$`Longitud Pico`,
name = "Chinstrap") %>%
layout(barmode = "overlay",
title = "Histograma por Grupos de la Longitud Pico",
xaxis = list(title = "Longitud Pico",
zeroline = FALSE),
yaxis = list(title = "Cuenta",
zeroline = FALSE))
p5fig <- plot_ly(penguins_df, y = ~penguins_df$`Longitud Pico`, color = ~penguins_df$Especie,
type = "box",colors=c("pink4","plum","pink"))%>%
layout(title="Longitud Pico",
yaxis= list(title="Longitud"))
figComentarios:
Analizando las longitudes de Pico en las 3 especies notamos que las especies Gentoo y Chinstrap tienen el pico mucho más grande que la especie Adelie y existe un individuo de la especie Gentoo con una longitud atipíca.
Observamos que la dispersión de los datos para la longitud de pico en general es baja para las 3 especies.
De acuerdo a los Box plots para los grupos Adelie y Gentoo se observa una distribución simétrica y una asimetrica negativa para el grupo Chinstrap.
El 50% de los pingüinos Adelie tienen una longitud de pico entre 36.7 y 48.8 cm.
El 50% de los Pingüinos Chinstrap tienen una longitud de pico entre 46.3 y 51.15 cm.
El 50% de los Pingüinos Gentoo tienen una longitud de pico entre 45.325 y 49.6 cm.
Los Pingüinos de la especie Chinstrap poseen el pico más largo.
- Profundidad de Pico
p6 <- plot_ly(alpha = 0.7) %>%
add_histogram(x = ~groupA$`Profundidad Pico`,
name = "Adelie") %>%
add_histogram(x = ~groupB$`Profundidad Pico`,
name = "Gentoo") %>%
add_histogram(x = ~groupC$`Profundidad Pico`,
name = "Chinstrap") %>%
layout(barmode = "overlay",
title = "Histograma por Grupos de la Profundidad del Pico",
xaxis = list(title = "Profundidad de Pico",
zeroline = FALSE),
yaxis = list(title = "Cuenta",
zeroline = FALSE))
p6fig2 <- plot_ly(penguins_df, y = ~penguins_df$`Profundidad Pico`, color = ~penguins_df$Especie,
type = "box",colors=c("indianred3","indianred4","coral"))%>%
layout(title="Profundidad Pico",
yaxis= list(title="Profundidad"))
fig2Comentarios:
La especie Adelie y Chinstrap tienen una profundidad de Pico mucho más alta que la especie Gentoo y existe un individuo de la especie Adelie con una profundidad inusual.
La dispersión de los datos no es tan alta, porque los diagramas de cajas y brazos son pequeños.
De acuerdo a los Box Plots los grupos Gentoo y Chinstrap presentan una distribución simétrica y para el grupo Adelie se observa una ligera distribución asimetrica negativa, ya que la mediana se acerca a el tercer cuartil.
El 50% de los pingüinos Adelie tienen una profundidad de pico entre 17.5 y 19 cm.
El 50% de los Pingüinos Chinstrap tienen una profundidad de pico entre 17.5 y 19.4 cm.
El 50% de los Pingüinos Gentoo tienen una profundidad de pico entre 14.2 y 15.775 cm.
Los Pingüinos de la especie Adelie y Chinstrap poseen el pico más profundo.
- Longitud de Aleta
p7 <- plot_ly(alpha = 0.7) %>%
add_histogram(x = ~groupA$`Longitud aleta`,
name = "Adelie") %>%
add_histogram(x = ~groupB$`Longitud aleta`,
name = "Gentoo") %>%
add_histogram(x = ~groupC$`Longitud aleta`,
name = "Chinstrap") %>%
layout(barmode = "overlay",
title = "Histograma por Grupos de la Longitud de Aleta",
xaxis = list(title = "Longitud de Aleta",
zeroline = FALSE),
yaxis = list(title = "Cuenta",
zeroline = FALSE))
p7fig3 <- plot_ly(penguins_df, y = ~penguins_df$`Longitud aleta`, color = ~penguins_df$Especie,
type = "box",colors=c("lightgoldenrod3","darkgoldenrod1","sandybrown"))%>%
layout(title="Longitud de Aleta",
yaxis= list(title="Longitud"))
fig3Comentarios:
Los pingüinos Gentoo tienen unas aletas mucho más largas que las otras especies.
Existen 2 individuos con aletas muy largas y muy pequeñas en la especie Adelie
La dispersión de los datos no es tan alta, porque los diagramas de cajas y brazos no son muy largos.
Las mediana del grupo Gentoo difiere mucho de las otras especies.
El 50% de los pingüinos Adelie tienen una longitud de aleta entre 186.5 y 195 cm.
El 50% de los Pingüinos Chinstrap tienen una longitud de aleta entre 191 y 201 cm.
El 50% de los Pingüinos Gentoo tienen una longitud de aleta entre 212 y 221.75 cm.
- Masa Corporal
p8 <- plot_ly(alpha = 0.7) %>%
add_histogram(x = ~groupA$`Masa Corporal`,
name = "Adelie") %>%
add_histogram(x = ~groupB$`Masa Corporal`,
name = "Gentoo") %>%
add_histogram(x = ~groupC$`Masa Corporal`,
name = "Chinstrap") %>%
layout(barmode = "overlay",
title = "Histograma por Grupos de la Masa Corporal",
xaxis = list(title = "Masa Corporal ",
zeroline = FALSE),
yaxis = list(title = "Cuenta",
zeroline = FALSE))
p8fig4 <- plot_ly(penguins_df, y = ~penguins_df$`Masa Corporal`, color = ~penguins_df$Especie,
type = "box",colors= "Paired")%>%
layout(title="Masa Corporal",
yaxis= list(title="Masa"))
fig4Comentarios:
Los pingüinos Gentoo son los más gordos.
Existen 2 individuos en la especie Chinstrap con peso muy bajo y muy alto para su especie.
En los box plots se aprecia que el grupo Chinstrap muestra una distribución simétrica, el grupo Adelie una ligera distribución asimétrica negativa y el grupo Gentoo una ligera distribución asimétrica positiva.
El 50% de los pingüinos Adelie tienen una masa entre 3350 y 4000 gr.
El 50% de los Pingüinos Chinstrap tienen una masa entre 3475 y 3950 gr.
El 50% de los Pingüinos Gentoo tienen una masa entre 4700 y 5500 gr.
varc <- data.frame("L.Pico"=penguins_df$`Longitud Pico`,
"P.Pico"=penguins_df$`Profundidad Pico`,
"L.Aleta"=penguins_df$`Longitud aleta`,
"M.Corporal"=penguins_df$`Masa Corporal`
)
ggcorrplot(cor(varc),hc.order = TRUE,lab = TRUE) #Usando Coeficiente de Pearsonpairs.panels(varc,method = "spearman",density=FALSE,ellipses = FALSE,
smooth = FALSE) #Usando coeficiente de SpearmanComentarios:
Usando ambos coeficientes de correlación observamos los siguiente:
La masa corporal tiene una correlación positiva muy fuerte con la Longitud de aleta.
La longitud de Pico tiene una correlación positiva con la Longitud de aleta y la masa corporal.
La profundidad del Pico tiene una correlación negativa con la longitud de aleta y la masa corporal.
c:
Para esta sección usaremos la variable de masa corporal.
Primero visualizaremos la gráfica de la variable elegida
p15 <- plot_ly(alpha = 0.7) %>%
add_histogram(x = ~penguins_df$`Masa Corporal`,
name = "Masa Corporal") %>%
layout(barmode = "overlay",
title = "Histograma de Masa Corporal",
xaxis = list(title = "Masa Corporal",
zeroline = FALSE),
yaxis = list(title = "Cuenta",
zeroline = FALSE))
p15De manera visual una distribición Gamma o Weibull podrían ajustar a la variable, para estar más seguros usaremos la gráfica de Cullen y Frey.
## summary statistics
## ------
## min: 2700 max: 6300
## median: 4050
## mean: 4207.057
## estimated sd: 805.2158
## estimated skewness: 0.4722461
## estimated kurtosis: 2.266511
Observamos que una distribución Gamma en efecto podría ajustar bien, las distribuciones normal y log normal no difieren mucho en simetria y Curtosis, por eso también las consideraremos. Por, ultimo incluiremos también la distribución weibull para tener una opción más para comparar.
La distribución exponencial no fue elegida porque esta muy lejos en simetría y la uniforme fue descartada por la ilustración del histograma.
Posibles candidatos
#Estimación Weibull
fitw <- fitdistr(y,densfun="weibull",lower = c(0, 0))
alfaw <- fitw$estimate[1]
betaw <- fitw$estimate[2]
#Estimación Gamma
fiteg <- fitdistr(y,densfun="gamma")
alfag <- fiteg$estimate[1]
betag <- fiteg$estimate[2]
#Estimación Log Normal
fitel<- fitdistr(y,densfun="Lognormal")
meanl <- fitel$estimate[1]
sdl <- fitel$estimate[2]
#Estimación Normal
fitn<- fitdistr(y,densfun = "normal")
meann <- fitn$estimate[1]
sdn <- fitn$estimate[2]
Dist <- c("Weibull","Gamma","Log Normal","Normal")
p1 <- c(round(alfaw,2),round(alfag,2),round(meanl,2),round(meann,2))
p2 <- c(round(betaw,2),round(betag,2),round(sdl,2),round(sdn,2))
cdist <- cbind(Dist,p1,p2)
rownames(cdist) <- 1:4
colnames(cdist) <- c("Distribución","Paramétro 1","Paramétro 2")
cdist## Distribución Paramétro 1 Paramétro 2
## 1 "Weibull" "5.53" "4546.29"
## 2 "Gamma" "28.18" "0.01"
## 3 "Log Normal" "8.33" "0.19"
## 4 "Normal" "4207.06" "804.01"
dist_lnorm <- fitdist(penguins_df$`Masa Corporal`,distr = "lnorm")
dist_weibull <- fitdist(penguins_df$`Masa Corporal`,distr = "weibull")
dist_gamma <- fitdist(penguins_df$`Masa Corporal`,distr = "gamma")
dist_norm <- fitdist(penguins_df$`Masa Corporal`,distr = "norm")
p <- denscomp(
list(dist_lnorm, dist_weibull,dist_gamma,dist_norm),
legendtext = c("lognormal", "Weibull","Gamma","Normal"),
xlab = "Masa",
fitcol = c("red", "blue","orange","green"),
fitlty = 1,
xlegend = "topright",
plotstyle = "ggplot",
addlegend = FALSE)
p <- p +
ggplot2::ggtitle("Distribución Masa Corporal") +
theme_bw() +
theme(legend.position = "bottom")
#p
ggplotly(p)#Bayesianos
n = length(y)
k=2
bic.g = log(n)*k-(2*fiteg$loglik)
bic.l = log(n)*k-(2*fitel$loglik)
bic.n = log(n)*k-(2*fitn$loglik)
bic.w = log(n)*k-(2*fitw$loglik)
# Arcaike
k =2
aic.g = 2*k-(2*fiteg$loglik)
aic.l = 2*k-(2*fitel$loglik)
aic.n = 2*k-(2*fitn$loglik)
aic.w = 2*k-(2*fitw$loglik)
BIC <- c(bic.g,bic.l,bic.n,bic.w)
AIC <- c(aic.g,aic.l,aic.n,aic.w)
t <- cbind(BIC,AIC)
rownames(t) <- c("Gamma","Log Normal","Normal","Weibull")
t## BIC AIC
## Gamma 5394.430 5386.814
## Log Normal 5389.739 5382.123
## Normal 5411.907 5404.291
## Weibull 5435.646 5428.030
Comentarios Finales
En la gráfica se observa que el modelo Log Normal y Gamma ajustan mejor, pero es difícil seleccionar uno.
Obervando los criterios de Arcaike y Bayesiano notamos que en ambos criterios el mejor modelo es la distribución Log Normal
Usaremos como variable cualitativa la especie.
set.seed(191)
adelie <- sample(penguins_df$Especie=="Adelie",1000,replace=TRUE)
est.adelie <- sum(adelie)/length(adelie)
gentoo <- sample(penguins_df$Especie=="Gentoo",1000,replace=TRUE)
est.gentoo <- sum(gentoo)/length(gentoo)
chinstrap <-sample(penguins_df$Especie=="Chinstrap",1000,replace=TRUE)
est.chinstrap <- sum(chinstrap)/length(chinstrap)
especie <- c("Adelie","Gentoo","Chinstrap")
p_m <- c(est.adelie,est.gentoo,est.chinstrap)
prop <- cbind(especie,p_m)
rownames(prop)<-1:3
colnames(prop)<- c("Especie","Estimación ")
prop## Especie Estimación
## 1 "Adelie" "0.438"
## 2 "Gentoo" "0.355"
## 3 "Chinstrap" "0.201"
Para esta parte usaremos la longitud de pico y la profundidad de pico.
set.seed(191)
muestra.lpico <-sample(penguins_df$`Longitud Pico`,9000,replace=TRUE)
muestra.ppico <- sample(penguins_df$`Profundidad Pico`,9000,replace=TRUE)
media_lpico <- mean(muestra.lpico)
media_ppico <- mean(muestra.ppico)
var_lpico <- var(muestra.lpico)
var_ppico <- var(muestra.ppico)
cov_v <- cov(muestra.lpico,muestra.ppico)
r_est <- cov_v/(sqrt(var_lpico)*sqrt(var_ppico))
varia <- c("Longitud Pico","Profundidad Pico")
media.m <- c(round(media_lpico,4),round(media_ppico,4))
var.m <- c(round(var_lpico,4),round(var_ppico,4))
r.m <- c(round(r_est,4),round(r_est,4))
estim <- cbind(varia,media.m,var.m,r.m)
rownames(estim) <- 1:2
colnames(estim) <- c("Variable","Media Muestral","Varianza Muestral","Coef Variación")
estim## Variable Media Muestral Varianza Muestral Coef Variación
## 1 "Longitud Pico" "44.0034" "29.7446" "-0.0206"
## 2 "Profundidad Pico" "17.1721" "3.8771" "-0.0206"
Para esta sección usaremos la longitud de aleta
n <- ggplot(penguins_df, aes(sample=penguins_df$`Longitud aleta`)) +
geom_qq(color="slategray4")+geom_qq_line(color="springgreen",distribution = "qnorm",size=1)
n <- n + ggtitle("QQplot Longitud de Aleta") +
xlab("Cuantiles teóricos") + ylab("Cuantiles muestrales")
#ggplotly(n)
n##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: penguins_df$`Longitud aleta`
## D = 0.12494, p-value = 1.213e-13
##
## Shapiro-Wilk normality test
##
## data: penguins_df$`Longitud aleta`
## W = 0.95171, p-value = 5.393e-09
Comentarios:
lambda = BoxCox.lambda(penguins_df$`Longitud aleta`,method="loglik",lower=-10,upper=10)
trans.laleta = BoxCox(penguins_df$`Longitud aleta`, lambda)
dta_trans<- data.frame(
"Longitud_Aleta" = trans.laleta
)
n2 <- ggplot(dta_trans, aes(sample=Longitud_Aleta)) +
geom_qq(color="slategray4")+geom_qq_line(color="violetred1",distribution = "qnorm",size=1)
n2 <- n2 + ggtitle("QQplot Longitud de Aleta Transformada") +
xlab("Cuantiles teóricos") + ylab("Cuantiles muestrales")
ggplotly(n2)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: trans.laleta
## D = 0.094181, p-value = 1.624e-07
##
## Shapiro-Wilk normality test
##
## data: trans.laleta
## W = 0.96537, p-value = 4.049e-07
Comentarios:
Intervalos Para la Media
intm_1 <- t.test(x=penguins_df$`Longitud aleta`, conf.level=0.83)$conf.int
intm_2 <- t.test(x=penguins_df$`Longitud aleta`, conf.level=0.97)$conf.int
cat("Intervalo del 83% de confianza:\t",intm_1,"\n")## Intervalo del 83% de confianza: 199.9107 202.0232
## Intervalo del 97% de confianza: 199.293 202.6409
Comentarios:
En el primer intervalo se afirma con un 83% de confianza que la media de la longitud de aleta esta entre 199.91 y 202.02 cm.
En el segundo intervalo se afirma con un 97% de confianza que la media de la longitud de aleta esta entre 199.29 y 202.64 cm.
Cómo se aumento el nivel de confianza para el segundo intervalo, la longitud del intervalo es mayor.
Dado que no hay mucha diferencia entre los dos intervalos es preferible tomar el intervalo con 83% de confianza ya que es más preciso.
Intervalos Para la Varianza
intv_1 <- varTest(penguins_df$`Longitud aleta`,conf.level=0.83)$conf.int
intv_2 <- varTest(penguins_df$`Longitud aleta`,conf.level=0.97)$conf.int
cat("Intervalo del 83% de confianza:\t",intv_1,"\n")## Intervalo del 83% de confianza: 177.2643 219.3996
## Intervalo del 97% de confianza: 167.069 234.1163
Comentarios:
En el primer intervalo se afirma con un 83% de confianza que la varianza de la longitud de aleta esta entre 177.2643 y 219.3996 cm.
En el segundo intervalo se afirma con un 97% de confianza que la varianza de la longitud de aleta esta entre 167.069 y 234.1163 cm.
Como el nivel de significancia para el segundo intervalo es menor a el primero, el segundo intervalo es más grande.
Los intervalos difieren mucho en la estimación para el parámetro, aunque el primer intervalo es más preciso su incertidumbre es mayor, por lo que consideramos mejor tomar el segundo intervalo.
Intervalos Para la Desviación Estándar
intd_1 <- sqrt(varTest(penguins_df$`Longitud aleta`,conf.level=0.83)$conf.int)
intd_2 <- sqrt(varTest(penguins_df$`Longitud aleta`,conf.level=0.97)$conf.int)
cat("Intervalo del 83% de confianza:\t",intd_1,"\n")## Intervalo del 83% de confianza: 13.31406 14.81214
## Intervalo del 97% de confianza: 12.92552 15.30086
Comentarios:
En el primer intervalo se afirma con un 83% de confianza que la desviación estándar de la longitud de aleta esta entre 13.31406 y 14.81214 cm.
En el primer intervalo se afirma con un 97% de confianza que la desviación estándar de la longitud de aleta esta entre 12.92552 y 15.30086 cm.
Como el nivel de significancia para el segundo intervalo es menor a el primero, el segundo intervalo es más grande.
Los intervalos difieren mucho en la estimación para el parámetro, aunque el primer intervalo es más preciso su incertidumbre es mayor, por lo que consideramos mejor tomar el segundo intervalo.
Usaremos la especie como variable cualitativa, en ninguna especie tenemos menos de 10 ejemplares.
Poblaciones
Adelies <- groupA$`Longitud aleta`
Gentoos <- groupB$`Longitud aleta`
Chinstraps <- groupC$`Longitud aleta`Se supondrá normalidad e independencia, la varianza y media poblacional son desconocidas.
Diferencia de Varianzas
vartest_1<- var.test(Adelies,Gentoos,ratio=1,alternative="two.sided",conf.level = 0.83)$conf.int
vartest_2<- var.test(Adelies,Gentoos,ratio=1,alternative="two.sided",conf.level = 0.97)$conf.int
cat("Intervalo del 83% de confianza:\t",vartest_1,"\n")## Intervalo del 83% de confianza: 0.7688795 1.245941
## Intervalo del 97% de confianza: 0.6667367 1.4325
Comentarios
Diferencia de Medias
compm1<- t.test(Adelies,Gentoos,alternative="two.sided",paired = F,var.equal = T,
conf.level = 0.83)$conf.int
compm2 <- t.test(Adelies,Gentoos,alternative="two.sided",paired = F,var.equal = T,
conf.level = 0.97)$conf.int
cat("Intervalo del 83% de confianza:\t",compm1,"\n")## Intervalo del 83% de confianza: -28.2457 -26.0194
## Intervalo del 97% de confianza: -28.89771 -25.36739
Comentarios
Diferencia de Varianzas
vartest_3<- var.test(Adelies,Chinstraps,ratio=1,alternative="two.sided",
conf.level = 0.83)$conf.int
vartest_4<- var.test(Adelies,Chinstraps,ratio=1,alternative="two.sided",
conf.level = 0.97)$conf.int
cat("Intervalo del 83% de confianza:\t",vartest_3,"\n")## Intervalo del 83% de confianza: 0.6203826 1.103822
## Intervalo del 97% de confianza: 0.5200362 1.296713
Comentarios
Diferencia de Medias
compm3<- t.test(Adelies,Chinstraps,alternative="two.sided",paired = F,var.equal = T,
conf.level = 0.83)$conf.int
compm4 <- t.test(Adelies,Chinstraps,alternative="two.sided",paired = F,var.equal = T,
conf.level = 0.97)$conf.int
cat("Intervalo del 83% de confianza:\t",compm3,"\n")## Intervalo del 83% de confianza: -7.079362 -4.362217
## Intervalo del 97% de confianza: -7.876529 -3.565051
Comentarios
Diferencia de Varianzas
vartest_5<- var.test(Chinstraps,Gentoos,ratio=1,alternative="two.sided",
conf.level = 0.83)$conf.int
vartest_6<- var.test(Chinstraps,Gentoos,ratio=1,alternative="two.sided",
conf.level = 0.97)$conf.int
cat("Intervalo del 83% de confianza:\t",vartest_5,"\n")## Intervalo del 83% de confianza: 0.8776468 1.59396
## Intervalo del 97% de confianza: 0.7414484 1.910254
Comentarios
Diferencia de Medias
compm5<- t.test(Chinstraps,Gentoos,alternative="two.sided",paired = F,var.equal = T,
conf.level = 0.83)$conf.int
compm6 <- t.test(Chinstraps,Gentoos,alternative="two.sided",paired = F,var.equal = T,
conf.level = 0.97)$conf.int
cat("Intervalo del 83% de confianza:\t",compm5,"\n")## Intervalo del 83% de confianza: -22.83336 -19.99017
## Intervalo del 97% de confianza: -23.66861 -19.15492
Comentarios
Ya que desconocemos los paramétros poblacionales, para trabajar esta sección se tomará que la muestra de 330 pingüinos es la población total y a partir de ella se tomarán muestras aleatorias para los ejercicios.
Además dado que la variable longitud de aleta no fue posible de normalizar con la transformación de Box Cox, se usará la variable original y se supondrá normalidad.
set.seed(11)
poblacion <- penguins_df$`Longitud aleta`
muestra <- sample(poblacion,50)
m_pob<-mean(poblacion)
m_mue<-mean(muestra)Contraste para la Media
Supongase que la longitud de aleta de los pingüinos es una v.a normal con media mu y desviacion estándar sigma = 14.01577, de acuerdo con la muestra ¿Existe razón para creer, con una significancia del 3% que la media de la longitud no es de 200.967 cm?.
\(H_{0}: \mu = 200.967\)
y
\(H_{1}: \mu \neq 200.967\)
Supuestos
# Region critica
zcrit1 <- qnorm(0.03/2,mean=0,sd=1,lower.tail = T)
zcrit2 <- qnorm(0.03/2,mean=0,sd=1,lower.tail = F)
zcrit2## [1] 2.17009
## [1] -2.17009
Como la varianza es conocida el estadístico sigue una distribucion Z
prueba1 <- z.test(muestra,alternative="two.sided",mu=200.967,sigma.x=14.01577,
conf.level=0.97)
prueba1##
## One-sample z-Test
##
## data: muestra
## z = 0.6826, p-value = 0.4949
## alternative hypothesis: true mean is not equal to 200.967
## 97 percent confidence interval:
## 198.0186 206.6214
## sample estimates:
## mean of x
## 202.32
Conclusión
Contraste para la Desviación Estándar
De acuerdo a la muestra aleatoria obtenida, con una significancia del 3%, ¿Existe razón para creer que la desviación tipíca es es distinta a 14.01577?
\(H_{0}: \sigma = 14.01577\)
y
\(H_{1}: \sigma \neq 14.01577\)
Supuestos
El estadístico sigue una distribución chi cuadrada con 49 grados de libertad, como la queremos para la desviación le sacamos raíz cuadrada.
# Region critica adaptada a la desviación estandár
chi_tab <- sqrt(qchisq(0.03/2,49,lower.tail = FALSE))
chi_tab## [1] 8.537695
##
## Chi-Squared Test on Variance
##
## data: muestra
## Chi-Squared = 49, df = 49, p-value = 0.9463
## alternative hypothesis: true variance is not equal to 198.7527
## 97 percent confidence interval:
## 133.6065 324.2357
## sample estimates:
## variance
## 198.7527
## Chi-Squared
## 7
Conclusión
Para terminar haremos la comparación entre la longitud de aleta entre hembras y machos.
fem <- penguins_df %>% filter(Sexo == "female")
masc <- penguins_df %>% filter(Sexo == "male")
fem_la <- fem$`Longitud aleta`
masc_la <- masc$`Longitud aleta`Cociente de Varianzas
¿Son las varianzas de la longitud de aleta diferentes entre hembras y machos?
\(H_{0}: \frac{\sigma_{1}^2}{\sigma_{2}^2} = 0\)
y
\(H_{1}: \frac{\sigma_{1}^2}{\sigma_{2}^2} \neq 0\)
Supuestos
Normalidad
Muestras independientes
Varianza Poblacional Desconocida
##
## F test to compare two variances
##
## data: fem_la and masc_la
## F = 0.73837, num df = 164, denom df = 167, p-value = 0.05203
## alternative hypothesis: true ratio of variances is not equal to 1
## 97 percent confidence interval:
## 0.5263648 1.0362796
## sample estimates:
## ratio of variances
## 0.7383713
##
## F test to compare two variances
##
## data: fem_la and masc_la
## F = 0.73837, num df = 164, denom df = 167, p-value = 0.05203
## alternative hypothesis: true ratio of variances is not equal to 1
## 83 percent confidence interval:
## 0.5962894 0.9145685
## sample estimates:
## ratio of variances
## 0.7383713
Conclusión
La conclusión es distinta entre los intervalos:
Con un 3% de significancia, como el intervalo de confianza contiene el 1 y el valor p es es mayor a la significancia dada, esto concluiría que no hay evidencia suficiente para pensar que las varianzas difieren.
Con un 17% de significancia, ocurre lo contrario, ya que el intervalo no contiene el 1 y además el valor p es menor es menor a el nivel de significancia.
Como se desea tener menor error, en este caso prefiero tomar la significancia del 3% y para la diferencia de promedios se tomarán varianzas poblacionales iguales.
Diferencia de Medias
¿Son los promedios longitud de aleta diferentes entre hembras y machos?
\(H_{0}: \mu_{1}-\mu_{2} = 0\)
y
\(H_{1}: \mu_{1}-\mu_{2} \neq 0\)
Supuestos
Normalidad
Muestras independientes
Varianza Poblacional Desconocida
##
## Two Sample t-test
##
## data: fem_la and masc_la
## t = -4.8013, df = 331, p-value = 2.391e-06
## alternative hypothesis: true difference in means is not equal to 0
## 97 percent confidence interval:
## -10.384456 -3.900177
## sample estimates:
## mean of x mean of y
## 197.3636 204.5060
##
## Two Sample t-test
##
## data: fem_la and masc_la
## t = -4.8013, df = 331, p-value = 2.391e-06
## alternative hypothesis: true difference in means is not equal to 0
## 83 percent confidence interval:
## -9.188020 -5.096612
## sample estimates:
## mean of x mean of y
## 197.3636 204.5060
Conclusión
En este caso la conclusión es la misma, el valor p es mucho menor a la significancia del 3% y 17%, además ningún intervalo contiene al cero y como ambos extremos del intervalo son negativos esto implica que la media de población de machos es mayor a las hembras.
Con una significancia del 3% y 17% se rechaza Ho y se concluye que la diferencia de medias entre hembras y machos es distinta.